;; Copyright © 2016, cage
;; All rights reserved.

;; Redistribution and use in source and binary forms, with or without
;; modification, are permitted provided that the following conditions are met:

;;     * Redistributions of source code must retain the above copyright
;; notice, this list of conditions and the following disclaimer.
;;     * Redistributions in binary form must reproduce the above copyright
;; notice, this list of conditions and the following disclaimer in the
;; documentation and/or other materials provided with the distribution.

;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
;; AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
;; ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
;; LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
;; CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
;; ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
;; THE POSSIBILITY OF SUCH DAMAGE.

(in-package :mini-kanren-test)

(defsuite mini-kanren-goodies-suite (tests-suite))

(defmacro define-mini-kanren-test ((name) &body body)
  `(define-kanren-test (,name mini-kanren-goodies-suite)
     ,@body))

(define-mini-kanren-test (ch-1.56)
  (run nil (x)
    (teacupo x))
  (tea cup))

(define-mini-kanren-test (ch-1.57)
  (run nil (r)
    (fresh (x y)
      (conde ((teacupo x) (== 't y) +succeed+)
	     ((== 'nil x) (== 't y))
	     (else +fail+))
      (== (cons x (cons y '())) r)))
  ;;  ((tea t)(cup t)(nil t))) original
  ((nil t) (tea t) (cup t)))

(define-mini-kanren-test (ch-1.58)
  (run nil (r)
    (fresh (x y z)
      (conde ((== y x) (fresh (x)(== z x)))
	     ((fresh (x) (== y x)) (== z x))
	     (else +fail+))
      (== (cons y (cons z '())) r)))
  ((:_.0 :_.1)(:_.0 :_.1)))

(define-mini-kanren-test (ch-1.59)
  (run nil (r)
    (fresh (x y z)
      (conde ((== y x) (fresh (x)(== z x)))
	     ((fresh (x) (== y x)) (== z x))
	     (else +fail+))
      (== 'nil x)
      (== (cons y (cons z '())) r)))
  ((nil :_.0)(:_.0 nil)))

(define-mini-kanren-test (ch-1.60)
  (run nil (q)
    (let ((a (== 't q))
	  (b (== 'nil q)))
      (declare (ignorable a))
      b))
  (nil))

(define-mini-kanren-test (ch-1.61)
  (run nil (q)
    (let ((a (== 't q))
	  (b (fresh (x)
	       (== x q)
	       (== 'nil x)))
	  (c (conde ((== 't q) +succeed+)
		    (else (== 'nil q)))))
      (declare (ignorable a c))
      b))
  (nil))
;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;chapter 2)
;;
(define-mini-kanren-test (ch-2.2)
  (run nil (r)
    (fresh (y x)
      (== `(,x ,y) r)))
  ((:_.0 :_.1)))

(define-mini-kanren-test (ch-2.3)
  (run nil (r)
    (fresh (v w)
      (== (let ((x v)
		(y w))
	    `(,x ,y))
	  r)))
  ((:_.0 :_.1)))

(define-mini-kanren-test (ch-2.6)
  (run nil (r)
    (caro '(a c o r n) r))
  (a))

(define-mini-kanren-test (ch-2.7)
  (run nil (q)
    (caro '(a c o r n) 'a)
    (== 't q))
  (t))

(define-mini-kanren-test (ch-2.8)
  (run nil (r)
    (fresh (x y)
      (caro `(,r ,y) x)
      (== 'pear x)))
  (pear))

(define-mini-kanren-test (ch-2.11)
  (run nil (r)
    (fresh (x y)
      (caro '(grape raisin pear) x)
      (caro '((a)(b)(c)) y)
      (== (cons x y) r)))
  ((grape a)))

(define-mini-kanren-test (ch-2.15)
  (run nil (r)
    (fresh (v)
      (cdro '(a c o r n) v)
      (caro v r)))
  (c))

(define-mini-kanren-test (ch-2.18)
  (run nil (r)
    (fresh (x y)
      (cdro '(grape raisin pear) x)
      (caro '((a)(b)(c)) y)
      (== (cons x y) r)))
  (((raisin pear) a)))

(define-mini-kanren-test (ch-2.19)
  (run nil (q)
    (cdro '(a c o r n) '(c o r n))
    (== 't q))
  (t))

(define-mini-kanren-test (ch-2.20)
  (run nil (x)
    (cdro '(c o r n) `(,x r n)))
  (o))

(define-mini-kanren-test (ch-2.21)
  (run nil (l)
    (fresh (x)
      (cdro l '(c o r n))
      (caro l x)
      (== 'a x)))
  ((a c o r n)))

(define-mini-kanren-test (ch-2.22)
  (run nil (l)
    (conso '(a b c) '(d e) l))
  (((a b c) d e)))

(define-mini-kanren-test (ch-2.23)
  (run nil (x)
    (conso x '(a b c) '(d a b c)))
  (d))

(define-mini-kanren-test (ch-2.24)
  (run nil (r)
    (fresh (x y z)
      (== `(e a d ,x) r)
      (conso y `(a ,z c) r)))
  ((e a d c)))

(define-mini-kanren-test (ch-2.25)
  (run nil (x)
    (conso x `(a ,x c) `(d a ,x c)))
  (d))

(define-mini-kanren-test (ch-2.26)
  (run nil (l)
    (fresh (x)
      (== `(d a ,x c) l)
      (conso x `(a ,x c) l)))
  ((d a d c)))

(define-mini-kanren-test (ch-2.27)
  (run nil (l)
    (fresh (x)
      (conso x `(a ,x c) l)
      (== `(d a ,x c) l)))
  ((d a d c)))

(define-mini-kanren-test (ch-2.29)
  (run nil (l)
    (fresh (d x y w s)
      (conso w '(a n s) s)
      (cdro l s)
      (caro l x)
      (== 'b x)
      (cdro l d)
      (caro d y)
      (== 'e y)))
  ((b e a n s)))

(define-mini-kanren-test (ch-2.32)
  (run nil (q)
    (nullo '(grape raisin pear))
    (== 't q))
  ())

(define-mini-kanren-test (ch-2.33)
  (run nil (q)
    (nullo '())
    (== 't q))
  (t))

(define-mini-kanren-test (ch-2.34)
  (run nil (x)
    (nullo x))
  (()))

(define-mini-kanren-test (ch-2.38)
  (run nil (q)
    (eqo 'pear 'plum)
    (== 't q))
  ())

(define-mini-kanren-test (ch-2.39)
  (run nil (q)
    (eqo 'plum 'plum)
    (== 't q))
  (t))

(define-mini-kanren-test (ch-2.52)
  (run nil (r)
    (fresh (x y)
      (== (cons x (cons y 'salad)) r)))
  ((:_.0 :_.1 . salad)))

(define-mini-kanren-test (ch-2.54)
  (run nil (q)
    (pairo (cons q q))
    (== 't q))
  (t))

(define-mini-kanren-test (ch-2.55)
  (run nil (q)
    (pairo '())
    (== 't q))
  ())

(define-mini-kanren-test (ch-2.56)
  (run nil (q)
    (pairo 'pair)
    (== 't q))
  ())

(define-mini-kanren-test (ch-2.57)
  (run nil (x)
    (pairo x))
  ((:_.0 . :_.1)))

(define-mini-kanren-test (ch-2.58)
  (run nil (r)
    (pairo (cons r 'pear)))
  (:_.0))
;;;;;;;;;;;;;;;;;;;;;;;
;;;chapter 3)
;;
(define-mini-kanren-test (ch-3.7)
  (run nil (x)
    (listo `(a b ,x d)))
  (:_.0))

(define-mini-kanren-test (ch-3.10)
  (run 1 (x)
    (listo `(a b c . ,x)))
  (()))

(define-mini-kanren-test (ch-3.14)
  (run 5 (x)
    (listo `(a b c . ,x)))
  (()
   (:_.0)
   (:_.0 :_.1)
   (:_.0 :_.1 :_.2)
   (:_.0 :_.1 :_.2 :_.3)))

(define-mini-kanren-test (ch-3.20)
  (run 1 (l)
    (lolo l))
  (()))

(define-mini-kanren-test (ch-3.21)
  (run nil (q)
    (fresh (x y)
      (lolo `((a b)(,x c)(d ,y)))
      (== 't q)))
  (t))

(define-mini-kanren-test (ch-3.22)
  (run 1 (q)
    (fresh (x)
      (lolo `((a b) . ,x))
      (== 't q)))
  (t))

(define-mini-kanren-test (ch-3.23)
  (run 1 (x)
    (lolo `((a b)(c d) . ,x)))
  (()))

;; this test gives  results differents from the book, i  can not see a
;; reason why this  was wrong, though. I suspect  this happens because
;; what is 'conde' in the book is is 'condi' actually.
(define-mini-kanren-test (ch-3.24)
  (run 5 (x)
    (lolo `((a b)(c d) . ,x)))
  (()
   (())
   ((:_.0))
   (() ())
   ((:_.0 :_.1))))

(define-mini-kanren-test (ch-3.32)
  (run nil (q)
    (twinso-0 '(tofu tofu))
    (== 't q))
  (t))

(define-mini-kanren-test (ch-3.32-bis)
  (run nil (q)
    (twinso-1 '(tofu tofu))
    (== 't q))
  (t))

(define-mini-kanren-test (ch-3.33)
  (run nil (z)
    (twinso-0 `(,z tofu)))
  (tofu))

(define-mini-kanren-test (ch-3.33-bis)
  (run nil (z)
    (twinso-1 `(,z tofu)))
  (tofu))

(define-mini-kanren-test (ch-3.38)
  (run 1 (z)
    (loto `((g g) . ,z)))
  (()))

(define-mini-kanren-test (ch-3.42)
  (run 5 (z)
    (loto `((g g) . ,z)))
  (()
   ((:_.0 :_.0))
   ((:_.0 :_.0) (:_.1 :_.1))
   ((:_.0 :_.0) (:_.1 :_.1) (:_.2 :_.2))
   ((:_.0 :_.0) (:_.1 :_.1) (:_.2 :_.2) (:_.3 :_.3))))

(define-mini-kanren-test (ch-3.45)
  (run 5 (r)
    (fresh (w x y z)
      (loto `((g g) (e ,w) (,x ,y) . ,z))
      (== `(,w (,x ,y) ,z) r)))
  ((e (:_.0 :_.0) ())
   (e (:_.0 :_.0) ((:_.1 :_.1)))
   (e (:_.0 :_.0) ((:_.1 :_.1) (:_.2 :_.2)))
   (e (:_.0 :_.0) ((:_.1 :_.1) (:_.2 :_.2) (:_.3 :_.3)))
   (e (:_.0 :_.0) ((:_.1 :_.1) (:_.2 :_.2) (:_.3 :_.3) (:_.4 :_.4)))))

(define-mini-kanren-test (ch-3.47)
  (run 3 (out)
    (fresh (w x y z)
      (== `((g g) (e ,w) (,x ,y) . ,z) out)
      (loto out)))
  (((g g) (e e) (:_.0 :_.0))
   ((g g) (e e) (:_.0 :_.0) (:_.1 :_.1))
   ((g g) (e e) (:_.0 :_.0) (:_.1 :_.1) (:_.2 :_.2))))

(define-mini-kanren-test (ch-3.49)
  (run 3 (out)
    (fresh (w x y z)
      (== `((g g) (e ,w) (,x ,y) . ,z) out)
      (listofo #'twinso out)))
  (((g g) (e e) (:_.0 :_.0))
   ((g g) (e e) (:_.0 :_.0) (:_.1 :_.1))
   ((g g) (e e) (:_.0 :_.0) (:_.1 :_.1) (:_.2 :_.2))))

(define-mini-kanren-test (ch-3.57)
  (run nil (q)
    (membero 'olive '(virgin olive oil))
    (== 't q))
  (t))

(define-mini-kanren-test (ch-3.58)
  (run 1 (y)
    (membero y '(hummus with pita)))
  (hummus))

(define-mini-kanren-test (ch-3.59)
  (run 1 (y)
    (membero y '(with pita)))
  (with))

(define-mini-kanren-test (ch-3.60)
  (run 1 (y)
    (membero y '(pita)))
  (pita))

(define-mini-kanren-test (ch-3.61)
  (run 1 (y)
    (membero y '()))
  ())

(define-mini-kanren-test (ch-3.62)
  (run nil (y)
    (membero y '(hummus with pita)))
  (hummus with pita))

(define-mini-kanren-test (ch-3.66)
  (run nil (x)
    (membero 'e `(pasta ,x fagioli)))
  (e))

(define-mini-kanren-test (ch-3.69)
  (run nil (x)
    (membero 'e `(pasta e ,x fagioli)))
  (:_.0 e))

(define-mini-kanren-test (ch-3.70)
  (run nil (x)
    (membero 'e `(pasta ,x e fagioli)))
  (e :_.0))

(define-mini-kanren-test (ch-3.71)
  (run nil (r)
    (fresh (x y)
      (membero 'e `(pasta ,x fagioli ,y))
      (== `(,x ,y) r)))
  ((e :_.0) (:_.0 e)))

(define-mini-kanren-test (ch-3.73)
  (run 1 (l)
    (membero 'tofu l))
  ((tofu . :_.0)))

(define-mini-kanren-test (ch-3.76)
  (run 5 (l)
    (membero 'tofu l))
  ((tofu . :_.0)
   (:_.0 tofu . :_.1)
   (:_.0 :_.1 tofu . :_.2)
   (:_.0 :_.1 :_.2 tofu . :_.3)
   (:_.0 :_.1 :_.2 :_.3 tofu . :_.4)))

;;3.81)

;;;;;;;;;;;;;;;;;;;;;;;;
;; Note: condi  is an  alias for  conde but  conde's behaviour  is the
;; condi one actually! See page 81 of 'trs', §6.26
;; In short: there is no more conde.
;;;;;;;;;;;;;;;;;;;;;;;
(define-mini-kanren-test (ch-6.24)
  (run 5 (r)
    (condi ((teacupo r) +succeed+)
	   ((== nil r) +succeed+)
	   (else +fail+)))
  (nil tea cup))

(define-mini-kanren-test (ch-6.25)
  (run 5 (q)
    (condi ((== 'nil q) +always+)
	   ((== 't q) +always+)
	   (else +fail+))
    (== 't q))
  (t t t t t))

(define-mini-kanren-test (ch-6.32)
  (run 5 (q)
    (alli
     (conde
       ((== 'nil q) +succeed+)
       (else
	(== 't q)))
     +always+)
    (== t q))
  (t t t t t))

(define-mini-kanren-test (ch-6.36)
  (run 5 (q)
    (all
     (conde
       (+succeed+ +succeed+)
       (else
	+never+))
     +always+)
    (== 't q))
  (t t t t t))

;;;;;;;;;;;;;;;;;;;;;;;
;;; chapter 7

(define-mini-kanren-test (ch-7.6)
  (run nil (s)
    (fresh (x y)
      (bit-xoro x y 0)
      (== `(,x ,y) s)))
  ((0 0)
   (1 1)))

;;;;;;;;;;;;;;;;;;;;;;;
;;; chapter 9)
(define-mini-kanren-test (ch-9.64)
  (run nil (q)
    (==-check q `(,q)))
  ())

;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-mini-kanren-test (ch-10.1)
  (run nil (q)
    (conda (+fail+ +succeed+)
	   (else +fail+)))
  ())

(define-mini-kanren-test (ch-10.2)
  (run nil (q)
    (conda (+fail+ +succeed+)
	   (else +succeed+)))
  (:_.0))

(define-mini-kanren-test (ch-10.3)
  (run nil (q)
    (conda (+succeed+ +fail+)
	   (else +succeed+)))
  ())

(define-mini-kanren-test (ch-10.4)
  (run nil (q)
    (conda (+succeed+ +succeed+)
	   (else +fail+)))
  (:_.0))

(define-mini-kanren-test (ch-10.5)
  (run nil (x)
    (conda ((== 'olive x) +succeed+)
	   ((== 'oil x) +succeed+)
	   (else +fail+)))
  (olive))

(define-mini-kanren-test (ch-10.7)
  (run nil (x)
    (conda ((== 'virgin x) +fail+)
	   ((== 'olive x) +succeed+)
	   ((== 'oil x) +succeed+)
	   (else +fail+)))
  ())

(define-mini-kanren-test (ch-10.14)
  (run nil (q)
    (condu (+always+ +succeed+)
	   (else +fail+))
    (== 't q))
  (t))

(define-mini-kanren-test (ch-10.18)
  (run 1 (q)
    (condu (+always+ +succeed+)
	   (else +fail+))
    +fail+
    (== 't q))
  ())

;;;; others tests not directly related to book

(define-mini-kanren-test (project-test)
  (run 1 (q)
    (fresh (x)
      (== x 2)
      (project (x)
	(== (= (rem x 2) 0)
	    't)))
    (== q 't))
  (t))

(defun palindromeo (total subtr)
  (conde
    ((== total subtr)
     +succeed+)
    ((fresh (f r)
       (caro total f)
       (cdro total r)
       (== r subtr)
       +succeed+))
    ((fresh (f r n)
       (caro total f)
       (cdro total r)
       (conso f subtr n)
       (palindromeo r n)))
    (else
     +fail+)))

(define-mini-kanren-test (palindrome-test)
  (run 6 (q)
    (palindromeo q '()))
  (nil
   (:|_.0|)
   (:|_.0| :|_.0|)
   (:|_.0| :|_.1| :|_.0|)
   (:|_.0| :|_.1| :|_.1| :|_.0|)
   (:|_.0| :|_.1| :|_.2| :|_.1| :|_.0|)))
